home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pnl006.zip / KB1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-17  |  16KB  |  517 lines

  1. Unit kb1 ;
  2.  
  3. interface
  4.  
  5. Uses
  6.  Crt, Graph, Globals, Legal_U, Replay, LoadSave, Moves, TBMoves, Draw_Pcs;
  7.  
  8. procedure Get_Keyboard ( var Game_State : Game_State_Type ) ;
  9.  
  10. { --------------------------------------------------------------- }
  11.  
  12. implementation
  13.  
  14. Type
  15.  
  16.     Piece_Select_Type = record
  17.         Selected : boolean;
  18.         Coords   : Coord_Type;
  19.     end;
  20.  
  21.  
  22. procedure  Arrow_Moves(var Cursor: Coord_Type; Piece_Select: Piece_Select_Type);
  23.  
  24. {   Author:  Jonathan Loux
  25.     Purpose: To update cursor positions on the board.
  26.     Pre:     Old Cursor coordinates.
  27.     Post:    Updated Cursor coordinates and put to board.
  28.  
  29. }
  30. var
  31.    Choice : char;
  32.  
  33. begin
  34.    Choice:= readkey;
  35.    with Cursor do
  36.    begin
  37.       Border_Square(Convert_File(xFile), Convert_Rank(Rank),brown);
  38.       case ord(Choice) of
  39.             75      :  if Rank > 1 then dec(Rank)        {left}
  40.                        else  beep;
  41.  
  42.                 77      :  if Rank < 8 then inc(Rank)        {right}
  43.                        else  beep;
  44.  
  45.             71      :  if (Rank > 1) and (xFile > 'a') then
  46.                           begin
  47.                              dec(Rank);
  48.                              dec(xFile);                   {Home}
  49.                           end
  50.                        else
  51.                              beep;
  52.  
  53.                 72      :  if xFile > 'a' then dec(xFile)    {up}
  54.                               else  beep;
  55.  
  56.             73      :  if (Rank < 8) and (xFile > 'a') then
  57.                        begin
  58.                           inc(Rank);                   {PgUp}
  59.                           dec(xFile)
  60.                        end
  61.                        else beep;
  62.  
  63.             79      :  if (Rank > 1) and (xFile < 'h') then
  64.                        begin
  65.                           dec(Rank);                      {End}
  66.                           inc(xFile)
  67.                        end
  68.                        else  beep;
  69.  
  70.                 80      :  if xFile < 'h' then inc(xFile)    {down}
  71.                               else  beep;
  72.  
  73.             81      :  if (Rank < 8) and (xFile < 'h') then
  74.                        begin
  75.                           inc(Rank);                     {PgDn}
  76.                           inc(xFile)
  77.                        end
  78.                        else beep;
  79.             117     :  begin
  80.                           Rank:= 1;
  81.                           xFile:= 'h'
  82.                        end;
  83.             118     :  begin
  84.                           Rank:= 8;
  85.                           xFile:= 'h'
  86.                        end;
  87.             119     :  begin
  88.                           Rank:= 1;
  89.                           xFile:= 'a'
  90.                        end;
  91.             132     :  begin
  92.                           Rank:= 8;
  93.                           xFile:= 'a';
  94.                        end;
  95.       end;  {case}
  96.      Border_Square(Convert_File(xFile),Convert_Rank(Rank), yellow);
  97.    end;  {with}
  98. end;     {Arrow_Moves}
  99.  
  100. {-------------------------------------------------------------------------}
  101.  
  102.  
  103. procedure Beep2;
  104.  
  105. begin
  106.    sound(50);
  107.    delay(200);
  108.    nosound;
  109. end;   {beep2}
  110.  
  111.  
  112. {-------------------------------------------------------------------------}
  113.  
  114.  
  115. procedure Beep4;
  116.  
  117. begin
  118.    sound(50);
  119.    delay(50);
  120. end;
  121.  
  122.  
  123. {-------------------------------------------------------------------------}
  124.  
  125.  
  126. procedure Select_A_Piece(Square: Coord_Type; PColor: integer; A_Piece: Piece_Type);
  127.  
  128. begin
  129.    with Square do
  130.       case A_Piece of
  131.          pawn    : Draw_Pawn(xFile,Rank,PColor);
  132.          rook    : Draw_Rook(xFile,Rank,PColor);
  133.          knight  : Draw_Knight(xFile,Rank,PColor);
  134.          bishop  : Draw_Bishop(xFile,Rank,PColor);
  135.          queen   : Draw_Queen(xFile,Rank,PColor);
  136.          king    : Draw_King(xFile,Rank,PColor);
  137.       end  {case}
  138. end;   {S_A_P}
  139.  
  140. {-------------------------------------------------------------------------}
  141.  
  142.  
  143. procedure Deselect(GS : Game_State_Type; var PS: Piece_Select_Type;
  144.                    Curr_Move : Move_Type; Message: string);
  145.  
  146. begin
  147.    with GS do  with PS do  with Curr_Move do
  148.    begin
  149.        Selected:= false;
  150.        if Board[Coords.xFile,Coords.Rank].side = white then
  151.           Select_A_Piece(Coords,15,Move_Piece)
  152.        else
  153.           Select_A_Piece(Coords,0,Move_Piece);
  154.        Error_Display(Message);
  155.    end
  156. end;
  157.  
  158.  
  159.  
  160.  
  161. {-------------------------------------------------------------------------}
  162.  
  163.  
  164. procedure Check_Move_Piece(var Game_State: Game_State_Type;
  165.                                     var Curr_Move: Move_Type;
  166.                                     var Cursor : Coord_Type;
  167.                                     var Piece_Select : Piece_Select_Type;
  168.                            var Legal : Boolean);
  169. {
  170.   Author:  Jonathan Loux
  171.  
  172.   Purpose: Checks if a piece is selected or not.  If it isn't then it is
  173.            selected to be moved.  Once one is selected, the procedure
  174.            checks if the square to where the piece is to be moved is not
  175.            the same as the piece.  If it is and the game mode is novice then
  176.            the piece is unselected, otherwise it is not a valid key.
  177.  
  178.   Pre:     Old Game_State
  179.            Curr_Move = Null or coordinates of piece to move
  180.            Cursor = coordinates of the piece to move
  181.            Piece_Select = true if selected, false if not
  182.  
  183.   Post:    Game_State is changed in Handle_Move_Request
  184.            Curr_Move = coords of piece to move or destination
  185.            Cursor = coordinates of the piece to move
  186.            Piece_Select = true if selected and not moved yet, false if
  187.                           deselected or moved.
  188. }
  189.  
  190.  
  191. var
  192.   count : integer;
  193.   A_Piece: Piece_Type;
  194.  
  195. begin
  196.     with Game_State do
  197.     begin
  198.       if Piece_Select.Selected = false then
  199.          {-------- Selecting a piece ---------------}
  200.       begin
  201.          if  board[Cursor.xFile,Cursor.Rank].Side = Side_to_move then
  202.    {-- piece to be selected must be on the same side as Side to move --}
  203.          begin
  204.              Piece_Select.Selected:= true;
  205.           A_Piece:= board[Cursor.xFile,Cursor.Rank].Piece;
  206.              Piece_Select.Coords.Rank:= Cursor.Rank;
  207.              Piece_Select.Coords.xFile:= Cursor.xFile;
  208.           Select_A_Piece(Piece_Select.Coords,14,A_Piece);
  209.              with Curr_Move do
  210.              begin    {---- set up initial coords of piece--}
  211.                  From_F:= Cursor.xFile;
  212.                  From_R:= Cursor.Rank;
  213.                  Piece_Side:= Side_to_move;
  214.                  Move_Piece:= A_Piece;
  215.              Move_Kind:= Checkall;
  216.              end;    {with}
  217.           Legal_Move(Game_State,Curr_Move,Legal,count);
  218.           if count = 0 then
  219.              Deselect(Game_State,Piece_Select,Curr_Move,
  220.                        'There are no legal moves for this piece.')
  221.           else
  222.              Error_Display('Piece Selected');
  223.          end        {if board}
  224.          else
  225.    {-- if not the same side as side to move or empty square selected--}
  226.  
  227.              Error_Display('ERROR: Not a piece to move')
  228.       end   {if selected}
  229.  
  230.       else
  231.      {---- A PIECE HAS BEEN SELECTED >> coords of Cursor are checked if
  232.            not the same as the piece   ------------------------------------}
  233.           if (Cursor.xFile <> Piece_Select.Coords.xFile) or
  234.            (Cursor.Rank <> Piece_Select.Coords.Rank) then
  235.               begin
  236.                   with Curr_Move do
  237.                   begin
  238.                {----------entering destination coordinates------}
  239.  
  240.                       To_F:= Cursor.xFile;
  241.                       To_R:= Cursor.Rank;
  242.                       Move_Kind:= normal;
  243.  
  244.                    end; {with}
  245.  
  246.            {------ checks if the move is legal ------------}
  247.  
  248.               Legal_Move(Game_State, Curr_Move, Legal, count);
  249.  
  250.                   if Legal = true then
  251.  
  252.            {------ if so then move is made -----------------}
  253.  
  254.                   begin
  255.                       Handle_Move_Request(Game_State, Curr_Move, Move_History);
  256.                       Piece_Select.Selected:= false;
  257.                  Show_Text(Game_State,Move_History);
  258.                  if Side_to_move = white then
  259.                     Cursor.Rank:=4
  260.                  else
  261.                     Cursor.Rank:=5;
  262.                  Cursor.xFile:= 'd';
  263.                  with Cursor do
  264.                  Border_Square(Convert_File(xFile),Convert_Rank(Rank),yellow);
  265.                  if Curr_Move.Move_Kind = Check then
  266.                    begin
  267.                      if Curr_Move.Piece_Side = Black then
  268.                          Error_Display('White is in Check')
  269.                        else
  270.                          Error_Display('Black is in Check');
  271.                    end
  272.                  else
  273.                    if Curr_Move.Move_Kind <> Mate then
  274.                    Error_Display('Move Completed.');
  275.  
  276.                   end
  277.                   else
  278.                       Error_Display('ERROR: Not a legal move');
  279.               end  {if ok to move}
  280.  
  281.           else
  282.  
  283.          {------- if piece selected is selected again and mode = novice
  284.                   then the piece is deselected ---------------------------}
  285.  
  286.           begin
  287.               if Mode = novice then
  288.               Deselect(Game_State,Piece_Select,Curr_Move,'Piece Deselected')
  289.               else
  290.                   Error_Display('ERROR: Not a legal move')
  291.           end;  {else}
  292.     end;       {the withs}
  293. end;          {Check_Move_Piece}
  294.  
  295.  
  296.  
  297. {--------------------------------------------------------------------------}
  298.  
  299.  
  300.  
  301. procedure Check_Legal_Piece(Game_State : Game_State_Type;
  302.                                      var Curr_Move : Move_Type;
  303.                                      Cursor : Coord_Type;
  304.                             Piece_Select: Piece_Select_Type);
  305.  
  306. {
  307.    Author:  Jonathan Loux
  308.  
  309.    Purpose: Checks if the square selected has a piece from the same side as
  310.             the side to move and then calls Legal Moves Request
  311.  
  312.    Pre:     Old Game_State
  313.             Curr_Move = Null
  314.             Cursor = Coords of the piece to check legal moves
  315.  
  316.    Post:    Game_State is unchanged
  317.             Curr_Move = Coords of piece to check and the piece
  318.             Cursor is unchanged
  319. }
  320.  
  321. var legal : boolean;
  322.     c:      integer;
  323.  
  324. begin
  325.     with Game_State do  with Curr_Move do
  326.         if board[Cursor.xFile,Cursor.Rank].Side = Side_to_move then
  327.         begin
  328.             From_F:= Cursor.xFile;
  329.             From_R:= Cursor.Rank;
  330.             Piece_Side:= Side_to_move;
  331.          Move_Kind:= ShowLegal;
  332.             Move_Piece:= board[Cursor.xFile,Cursor.Rank].Piece;
  333.             Legal_Move(Game_State, Curr_Move, Legal,c);
  334.         end
  335.       else
  336.         if Piece_Select.Selected = true then
  337.             Error_Display('Invalid Key')
  338.         else
  339.             Error_Display('ERROR: Not a piece to move');
  340. end;   {Check_Legal_Piece}
  341.  
  342.  
  343.  
  344.  
  345. {------------------------------------------------------------------------}
  346.  
  347.  
  348. procedure Handle_New_Game_Request(var Game_State: Game_State_Type);
  349.  
  350. var
  351.    Choice : char;
  352.  
  353. begin
  354.    InitGame(Game_State);
  355.    Draw_Board(Game_State);
  356. end;
  357.  
  358.  
  359. {------------------------------------------------------------------------}
  360.  
  361.  
  362. procedure Get_Keyboard (var Game_State: Game_State_Type);
  363.  
  364. {
  365.    Author:  Jonathan Loux
  366.  
  367.    Purpose: Retrieves the information inputted from the keyboard.  The type
  368.               of input is then processed and sent to the correct procedure.
  369.  
  370.    Pre:     Old Game_State
  371.  
  372.    Post:    End of game
  373. }
  374.  
  375. var
  376.    Legal    : Boolean;
  377.    TempGS   : Game_State_Type;
  378.    GameOver : boolean;
  379.    AChoice,
  380.     Choice: char;
  381.     Cursor : Coord_Type;
  382.     Piece_Select : Piece_Select_Type;
  383.  
  384. begin
  385.    Legal := False;
  386.    GameOver := False;
  387.     Piece_Select.Selected:= false;
  388.     with Game_State do
  389.     begin
  390.         Cursor.Rank:= 4;
  391.         Cursor.xFile:= 'd';
  392.       repeat
  393.             Border_Square(Convert_File(Cursor.xFile),Convert_Rank(Cursor.rank), yellow);
  394.             repeat
  395.                 Choice:= readkey;
  396.                 if not (ord(Choice) in [0,13,76..78,81..84,108..110,113..116])
  397.             then  Error_Display('Invalid Key');
  398.             until ord(Choice) in [0, 13, 76..78, 81..84, 108..110, 113..116];
  399.             case ord(Choice) of
  400.                  {----- Arrow  Keys ----------}
  401.  
  402.                 0       :  Arrow_Moves(Cursor,Piece_Select);
  403.  
  404.                  {----- Move Request ---------}
  405.  
  406.                 13      :  Check_Move_Piece(Game_State, Curr_Move, Cursor,
  407.                                         Piece_Select, Legal);    {move request}
  408.  
  409.                  {----- Legal Move Request -------}
  410.  
  411.                 77, 109 :  if Mode = novice then
  412.                                     Check_Legal_Piece(Game_State, Curr_Move, Cursor,
  413.                                               Piece_Select)
  414.                               else
  415.                            Error_Display('Invalid Key');    {legal moves}
  416.  
  417.                 {-------- Load Request -------------}
  418.  
  419.                 76, 108 :  if Piece_Select.Selected = false then
  420.                                   Handle_Load_Request
  421.                                   (Game_File, G, Game_State,Move_History)
  422.                               else
  423.                                   Error_Display('ERROR: Must finish move first');
  424.  
  425.                  {------ Save Request -----------------}
  426.  
  427.                 83,115  :  if Piece_Select.Selected = false then
  428.                                   Handle_Save_Request
  429.                                    (Game_File, G, Game_State, Move_History)
  430.                               else
  431.                                   Error_Display('ERROR: Must finish move first');
  432.  
  433.                  {------ Replay Request -------------}
  434.  
  435.                 82, 114 :  if Piece_Select.Selected = false
  436.                               then  Handle_Replay_Request(Game_State)
  437.                        else
  438.                                   Error_Display('ERROR: Must finish move first');
  439.  
  440.                  {------ Take Back Request --------------}
  441.  
  442.                 84, 116 :  if Mode = Novice  then
  443.                               begin
  444.                                  if Piece_Select.Selected = false
  445.                                  then
  446.                            begin
  447.                              if Game_State.Move_Number > 1 then
  448.                                Handle_Take_Back_Move_Request
  449.                                (Game_State, Curr_Move, Move_History)
  450.                              else
  451.                                Error_Display('No moves to take back.')
  452.                            end
  453.                                  else
  454.                                      Error_Display('ERROR: Must finish move first')
  455.                               end   {if M = N }
  456.                               else
  457.                                   Error_Display('Invalid Key');
  458.  
  459.                 {------- New Game Request ----------}
  460.  
  461.                 78,110  : begin
  462.                         AChoice := 'f';
  463.                         while not (AChoice in ['y','Y','n','N']) do
  464.                           begin
  465.                             prompt('Save Game? (Y/N)');
  466.                             AChoice := Readkey
  467.                           end;
  468.                         If AChoice in ['y','Y'] then
  469.                            Handle_Save_Request(Game_File, G, Game_State, Move_History);
  470.  
  471.                         if Piece_Select.Selected = false then
  472.                            Handle_New_Game_Request(Game_State)
  473.                         else
  474.                            Error_Display('ERROR: Must finish move first');
  475.                       end;
  476.  
  477.                  {-------- Quit Game --------------}
  478.  
  479.             81,113  : begin
  480.                         AChoice := 'f';
  481.                         while not (AChoice in ['y','Y','n','N']) do
  482.                           begin
  483.                             prompt('Save Game? (Y/N)');
  484.                             AChoice := Readkey
  485.                           end;
  486.                         If AChoice in ['y','Y'] then
  487.                            Handle_Save_Request
  488.                               (Game_File, G, Game_State, Move_History);
  489.                       end
  490.             end;  {case}
  491.       GameOver := Curr_Move.Move_Kind=Mate;
  492.       if GameOver then
  493.         begin
  494.           AChoice := 'f';
  495.           while not (AChoice in ['Y','y','N','n']) do
  496.             begin
  497.               if Curr_Move.Piece_Side = white then
  498.                 prompt('Check Mate! White Wins! Play again? (Y/N)')
  499.               else
  500.                 prompt('Check Mate! Black Wins! Play again? (Y/N)');
  501.               AChoice := ReadKey;
  502.               if AChoice in ['Y','y'] then
  503.                 begin
  504.                   Handle_New_Game_Request(Game_State);
  505.                   Show_Text(Game_State, Move_History);
  506.                   GameOver := false;
  507.                 end;
  508.             end;
  509.         end;
  510.  
  511.         until (Choice in['Q', 'q']) or (GameOver);
  512.     end;   {with}
  513. end;   { Get_Keyboard}
  514.  
  515.  
  516. end.   {KB1}
  517.